home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tpmemo.zip / ENTRY.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  30KB  |  984 lines

  1. {$S-,I-}
  2. {$V-}                        {<- required for TPENTRY}
  3. {$M 16384,16384,600000}
  4.  
  5. {$I TPDEFINE.INC}
  6.  
  7. {*********************************************************}
  8. {*                   ENTRY.PAS 5.02                      *}
  9. {*     An example program for Turbo Professional 5.0     *}
  10. {*        Copyright (c) TurboPower Software 1988.        *}
  11. {* Portions copyright (c) Sunny Hill Software 1985, 1986 *}
  12. {*     and used under license to TurboPower Software     *}
  13. {*                 All rights reserved.                  *}
  14. {*********************************************************}
  15.  
  16. program TpEntryDemo;
  17.   {-Demonstrates use of TPENTRY unit}
  18.  
  19. uses
  20.   TpString,                  {string handling}
  21.   TpCrt,                     {basic screen handling}
  22.   {$IFDEF UseMouse}
  23.   TpMouse,                   {mouse routines}
  24.   {$ENDIF}
  25.   TpDate,                    {date and time variables}
  26.   TpEntry,                   {data entry}
  27.   TpMemo,                    {memo field editor}
  28.   TpWindow,                  {window management}
  29.   TpPick,                    {pick lists}
  30.   TpHelp;                    {popup help}
  31.  
  32. const
  33.   TitleLine = 02;
  34.   StatusLine = 04;
  35.   HelpLine = 22;
  36.   KeyInfoLine = 24;
  37.   Title : string[38] = 'Demonstration Program for TPENTRY 5.02';
  38.   KeyInfoText : string[78] =
  39.   ' <F1> Help '^G' '^[^X^Y^Z' move cursor '^G' <Enter> Accept '^G' <Esc> Cancel '^G' <^Enter> Quit ';
  40. type
  41.   GenderType = (Unknown, Male, Female);
  42.   MemoField = array[1..2048] of Char;
  43.   Info =
  44.     record
  45.       Name : string[30];     {string field}
  46.       Address : string[30];  {string field}
  47.       City : string[25];     {string field}
  48.       State : string[02];    {string field w/ special validation}
  49.       Zip : string[10];      {string field w/ special validation}
  50.       WPhone : string[14];   {string field w/ special validation}
  51.       HPhone : string[14];   {string field w/ special validation}
  52.       Gender : GenderType;   {multiple choice field}
  53.       Married : Boolean;     {yes/no field}
  54.       Born : Date;           {date field}
  55.       Age : Byte;            {calculated field, based on Born}
  56.       Wage : Real;           {numeric field w/ range checking}
  57.       Weekly : Real;         {calculated field (= Wage * Hours)}
  58.       Hours : Byte;          {multiple choice field, incremental}
  59.       Yearly : Real;         {calculated field (= Weekly * 52)}
  60.       Notes : MemoField;     {a memo field}
  61.     end;
  62. const
  63.   MaxRec = 20;
  64.   PhoneMask : string[14] = '(999) 999-9999';
  65.   ValidPhone : string[14] = '(ppp) uuu-uuuu';
  66.   ZipMask : string[10] = '99999-9999';
  67.   ValidZip : string[10] = 'uuuuu-pppp';
  68.   Genders : array[GenderType] of string[7] = (
  69.     'Unknown', 'Male   ', 'Female ');
  70.   EmptyString : string[1] = '';
  71.   OurHelpColorAttr : HelpColorArray = ($1D, $1B, $5F, $5F, $3F, $1E, $1F, $1B);
  72.   OurHelpMonocAttr : HelpColorArray = ($0F, $07, $70, $70, $09, $0F, $0F, $0F);
  73. var
  74.   InfoRecs : array[1..MaxRec] of Info; {the "database"}
  75.   Scrap : Info;              {blank record used for editing}
  76.   CurrentRec : Byte;         {current index into InfoRecs}
  77.   ExitCommand : EStype;      {exit command returned by editor}
  78.   ESR1 : ESrecord;            {our main edit screen}
  79.   ESR2 : ESrecord;           {our nested edit screen}
  80.   BoxAttr : Byte;            {color of boxes}
  81.   BoxTextAttr : Byte;        {color of text in boxes}
  82.   ProtectAttr : Byte;        {attribute used for protected fields}
  83.   SaveFieldAttr : Byte;      {used to save ESfieldAttr}
  84.   PickColors : PickColorArray; {colors for TPPICK}
  85.   HelpColors : HelpColorArray; {colors for TPHELP}
  86.   SavePromptAttr : Byte;     {temporarily holds ESpromptAttr}
  87.   AllDone : Boolean;         {done with demo program}
  88.   HelpP : HelpPtr;           {pointer to help system}
  89.   WP1 : WindowPtr;           {points to window for second entry screen}
  90.   WP2 : WindowPtr;           {points to window for memo field editor}
  91.   DateMask : string[10];     {picture mask for date strings}
  92.   TimeMask : string[11];     {picture mask for time strings}
  93.   WageMask : string[10];     {picture mask for wage field}
  94.   CurrMask : string[15];     {picture mask for totals based on wages}
  95.  
  96. const
  97.   StateStrings : array[1..51] of string[19] = (
  98.     {01} 'AK Alaska',
  99.     {02} 'AL Alabama',
  100.     {03} 'AR Arkansas',
  101.     {04} 'AZ Arizona',
  102.     {05} 'CA California',
  103.     {06} 'CO Colorado',
  104.     {07} 'CT Connecticut',
  105.     {08} 'DC Dist of Columbia',
  106.     {09} 'DE Delaware',
  107.     {10} 'FL Florida',
  108.     {11} 'GA Georgia',
  109.     {12} 'HI Hawaii',
  110.     {13} 'IA Iowa',
  111.     {14} 'ID Idaho',
  112.     {15} 'IL Illinois',
  113.     {16} 'IN Indiana',
  114.     {17} 'KS Kansas',
  115.     {18} 'KY Kentucky',
  116.     {19} 'LA Louisana',
  117.     {20} 'MA Massachusetts',
  118.     {21} 'MD Maryland',
  119.     {22} 'ME Maine',
  120.     {23} 'MI Michigan',
  121.     {24} 'MN Minnesota',
  122.     {25} 'MO Missouri',
  123.     {26} 'MS Mississippi',
  124.     {27} 'MT Montana',
  125.     {28} 'NC North Carolina',
  126.     {29} 'ND North Dakota',
  127.     {30} 'NE Nebraska',
  128.     {31} 'NH New Hampshire',
  129.     {32} 'NJ New Jersey',
  130.     {33} 'NM New Mexico',
  131.     {34} 'NV Nevada',
  132.     {35} 'NY New York',
  133.     {36} 'OH Ohio',
  134.     {37} 'OK Oklahoma',
  135.     {38} 'OR Oregon',
  136.     {39} 'PA Pennsylvania',
  137.     {40} 'RI Rhode Island',
  138.     {41} 'SC South Carolina',
  139.     {42} 'SD South Dakota',
  140.     {43} 'TN Tennessee',
  141.     {44} 'TX Texas',
  142.     {45} 'UT Utah',
  143.     {46} 'VA Virginia',
  144.     {47} 'VT Vermont',
  145.     {48} 'WA Washington',
  146.     {49} 'WI Wisconsin',
  147.     {50} 'WV West Virginia',
  148.     {51} 'WY Wyoming');
  149.  
  150.   {$F+}
  151.   function ValidatePhone(var FR : FieldRec;
  152.                          var ErrCode : Byte;
  153.                          var ErrorSt : StringPtr) : Boolean;
  154.     {-Validate a phone number}
  155.   begin
  156.     ValidatePhone := ValidateSubfields(ValidPhone, FR, ErrCode, ErrorSt);
  157.   end;
  158.  
  159.   function ValidateZip(var FR : FieldRec;
  160.                        var ErrCode : Byte;
  161.                        var ErrorSt : StringPtr) : Boolean;
  162.     {-Validate a zip code}
  163.   begin
  164.     ValidateZip := ValidateSubfields(ValidZip, FR, ErrCode, ErrorSt);
  165.   end;
  166.  
  167.   function StateChoice(I : Word) : string;
  168.     {-Return a state string given an index}
  169.   begin
  170.     StateChoice := StateStrings[I];
  171.   end;
  172.   {$F-}
  173.  
  174.   procedure DisplayCentered(S : string; Row : Byte);
  175.     {-Display S centered on the specified Row}
  176.   begin
  177.     FastWrite(Center(S, 78), Row, 2, BoxTextAttr);
  178.   end;
  179.  
  180.   procedure ClearHelpLine;
  181.     {-Clear the help line}
  182.   begin
  183.     DisplayCentered(EmptyString, HelpLine);
  184.   end;
  185.  
  186.   {$F+}
  187.   function GetKey : Word;
  188.     {-Display current date and time while waiting for keypress}
  189.   begin
  190.     {$IFDEF UseMouse}
  191.     while not(KeyPressed or MousePressed) do begin
  192.     {$ELSE}
  193.     while not KeyPressed do begin
  194.     {$ENDIF}
  195.       {make sure TSR's can pop up}
  196.       inline($CD/$28);
  197.  
  198.       {display the current date and time}
  199.       FastWrite(TodayString(DateMask), StatusLine, 38, ESfieldAttr);
  200.       FastWrite(CurrentTimeString(TimeMask), StatusLine, 57, ESfieldAttr);
  201.     end;
  202.  
  203.     {$IFDEF UseMouse}
  204.     if KeyPressed then
  205.       GetKey := ReadKeyWord
  206.     else
  207.       GetKey := MouseKeyWord;
  208.     {$ELSE}
  209.       GetKey := ReadKeyWord
  210.     {$ENDIF}
  211.   end;
  212.  
  213.   procedure IncChoice(var Value; FieldID : Byte; Factor : Integer; var St : string);
  214.     {-Increment a multiple choice field value and convert it to a string}
  215.   var
  216.     Gender : GenderType absolute Value;
  217.     Hours : Byte absolute Value;
  218.   begin
  219.     if FieldID = 7 then begin
  220.       {Gender}
  221.       case Factor of
  222.         01 :                 {increment}
  223.           if Gender = Female then
  224.             Gender := Unknown
  225.           else
  226.             Inc(Gender);
  227.         -1 :                 {decrement}
  228.           if Gender = Unknown then
  229.             Gender := Female
  230.           else
  231.             Dec(Gender);
  232.       end;
  233.       St := Genders[Gender];
  234.     end
  235.     else if FieldID = 13 then begin
  236.       {Hours}
  237.       case Factor of
  238.         01 :                 {increment}
  239.           if Hours < 99 then
  240.             Inc(Hours);
  241.         -1 :                 {decrement}
  242.           if Hours > 0 then
  243.             Dec(Hours);
  244.       end;
  245.       Str(Hours:2, St);
  246.     end;
  247.   end;
  248.  
  249.   procedure DisplayErrorMessage(Msg : string);
  250.     {-Display an error message}
  251.   var
  252.     W, CursorSL, CursorXY : Word;
  253.   begin
  254.     {Store cursor position and shape, then make it a fat cursor}
  255.     GetCursorState(CursorXY, CursorSL);
  256.     FatCursor;
  257.  
  258.     {add to default message, if possible}
  259.     if Length(Msg) < 60 then
  260.       Msg := Msg+' Press any key...';
  261.  
  262.     {display error message and ring bell}
  263.     DisplayCentered(Msg, HelpLine);
  264.     RingBell;
  265.  
  266.     {flush keyboard buffer}
  267.     while KeyPressed do
  268.       W := GetKey;
  269.  
  270.     {wait for keypress, then clear the help line}
  271.     W := GetKey;
  272.     ClearHelpLine;
  273.  
  274.     {Restore cursor position and shape}
  275.     RestoreCursorState(CursorXY, CursorSL);
  276.   end;
  277.  
  278.   procedure ErrorHandler(var ESR : ESrecord; Code : Byte; Msg : string);
  279.     {-Display messages for errors reported by TPENTRY}
  280.   begin
  281.     DisplayErrorMessage(Msg);
  282.     case Code of
  283.       InitError, OverflowError, MemoryError, ParamError :
  284.         begin
  285.           {a fatal error: set normal cursor and clear the screen}
  286.           NormalCursor;
  287.           ClrScr;
  288.         end;
  289.     end;
  290.   end;
  291.  
  292.   procedure UpdateHandler(var ESR : ESrecord);
  293.     {-Called after a field has been edited}
  294.   var
  295.     Days, Months, Years : Integer;
  296.     ThisDate : Date;         {today's date in julian format}
  297.   begin
  298.     ThisDate := Today;
  299.     with Scrap do
  300.       case ESR.CurrentID of
  301.         09 :                 {Born}
  302.           begin
  303.             {calculate Age field}
  304.             if (Born = BadDate) or (Born > ThisDate) then
  305.               Age := 0
  306.             else begin
  307.               DateDiff(Born, ThisDate, Days, Months, Years);
  308.               Age := Years;
  309.             end;
  310.  
  311.             {redraw the Age field}
  312.             DrawField(ESR, 10);
  313.           end;
  314.         11,                  {Wage}
  315.         13 :                 {Hours}
  316.           begin
  317.             {calculate weekly and yearly earnings}
  318.             Weekly := Wage*Hours;
  319.             Yearly := Weekly*52;
  320.  
  321.             {redraw Weekly}
  322.             DrawField(ESR, 12);
  323.  
  324.             {redraw Yearly}
  325.             DrawField(ESR, 14);
  326.           end;
  327.       end;
  328.   end;
  329.  
  330.   procedure DisplayHelpPrompt(var ESR : ESrecord);
  331.     {-Display a help prompt for the current field}
  332.   var
  333.     S : string[80];
  334.   begin
  335.     case ESR.CurrentID of
  336.       {--Field 0 is the record number (protected)--}
  337.       01 : S := 'Enter first name, middle initial, last name';
  338.       02 : S := 'Enter street address or post office box';
  339.       03 : S := 'Enter city of residence';
  340.       04 : S := 'Enter state of residence or press <F2> to select from list';
  341.       05 : S := 'Enter a five- or nine-digit zip code';
  342.       06 : S := 'Press <Enter> to edit work and home phone numbers';
  343.       07 : S := 'Press space bar, "+" or "-" to select gender';
  344.       08 : S := 'Enter "N" if marital status is unknown, else "N" or "Y"';
  345.       09 : S := 'Enter date of birth';
  346.       {--Field 10 is Age (protected, calculated)--}
  347.       11 : S := 'Enter hourly wage ($0-$99.99)';
  348.       {--Field 12 is Weekly (protected, calculated)--}
  349.       13 : S := 'Press "+" or "-" to adjust hours worked per week';
  350.       {--Field 14 is Yearly (protected, calculated)--}
  351.       15 : S := 'Press <Enter> to edit notes field';
  352.     end;
  353.     DisplayCentered(S, HelpLine);
  354.   end;
  355.  
  356.   procedure DisplayHelpPrompt2(var ESR : ESrecord);
  357.     {-Display a help prompt for the current field}
  358.   var
  359.     S : string[80];
  360.   begin
  361.     case ESR.CurrentID of
  362.       00 : S := 'Enter work phone number (area code is optional)';
  363.       01 : S := 'Enter home phone number (area code is optional)';
  364.     end;
  365.     DisplayCentered(S, HelpLine);
  366.   end;
  367.  
  368.   procedure DisplayHelp(UnitCode : Byte; IdPtr : Pointer; HelpIndex : Word);
  369.     {-Display context sensitive help}
  370.   begin
  371.     {do nothing if help index is illegal}
  372.     if HelpIndex <> 0 then begin
  373.       {ignore the help index passed by TPPICK}
  374.       if UnitCode = HelpForPick then
  375.         HelpIndex := 4;
  376.  
  377.       {display the help screen}
  378.       if not ShowHelp(HelpP, HelpIndex) then
  379.         RingBell;
  380.     end;
  381.   end;
  382.  
  383.   procedure MemoFieldStatus(var EMCB : EMcontrolBlock);
  384.     {-Display status line for memo field}
  385.                               {         1         2         }
  386.   const                       {12345678901234567890123456789}
  387.     StatusLine : string[29] = ' Line: xxx Column: xxx 100% ';
  388.   var
  389.     S : string[5];
  390.   begin
  391.     with EMCB do begin
  392.       {insert line number}
  393.       S := Long2Str(CurLine);
  394.       S := Pad(S, 3);
  395.       Move(S[1], StatusLine[8], 3);
  396.  
  397.       {insert column number}
  398.       S := Long2Str(CurCol);
  399.       S := Pad(S, 3);
  400.       Move(S[1], StatusLine[20], 3);
  401.  
  402.       {insert percentage of buffer used}
  403.       S := Real2Str(Trunc((TotalBytes*100.0)/(BufSize-2)), 3, 0);
  404.       Move(S[1], StatusLine[24], 3);
  405.  
  406.       {$IFDEF UseMouse}
  407.       HideMouse;
  408.       {$ENDIF}
  409.  
  410.       {display status line}
  411.       FastWrite(StatusLine, 19, 27, BoxTextAttr);
  412.  
  413.       {$IFDEF UseMouse}
  414.       ShowMouse;
  415.       {$ENDIF}
  416.     end;
  417.   end;
  418.  
  419.   procedure MemoPrompt;
  420.     {-Display the prompt for the memo editor}
  421.   begin
  422.     DisplayCentered('Press <Esc> when finished entering notes', HelpLine);
  423.   end;
  424.  
  425.   procedure MemoErrorHandler(var EMCB : EMcontrolBlock; ErrorCode : Word);
  426.     {-Display error message and wait for key press}
  427.   begin
  428.     case ErrorCode of
  429.       tmBufferFull :
  430.         DisplayErrorMessage('Edit buffer is full.');
  431.       tmLineTooLong :
  432.         DisplayErrorMessage('Line too long, carriage return inserted.');
  433.       tmTooManyLines :
  434.         DisplayErrorMessage('Limit on number of lines has been reached.');
  435.       tmOverLineLimit :
  436.         DisplayErrorMessage('Limit on number of lines has been exceeded');
  437.       else
  438.         DisplayErrorMessage('Unknown error.');
  439.     end;
  440.  
  441.     {redisplay our prompt}
  442.     MemoPrompt;
  443.   end;
  444.   {$F-}
  445.  
  446.   procedure EditMemoField;
  447.     {-Edit a memo field}
  448.   const
  449.     NullCmdList : EMtype = EMnone;
  450.   var
  451.     ExitCommand : EMtype;
  452.     EMCB : EMcontrolBlock;
  453.   begin
  454.     {$IFDEF UseMouse}
  455.     {hide the mouse cursor}
  456.     HideMouse;
  457.     {$ENDIF}
  458.  
  459.     {display the window}
  460.     if not DisplayWindow(WP2) then {} ;
  461.  
  462.     {$IFDEF UseMouse}
  463.     {reveal the mouse cursor}
  464.     ShowMouse;
  465.     {$ENDIF}
  466.  
  467.     {initialize the edit control block}
  468.     InitControlBlock(
  469.       EMCB,                  {control block}
  470.       9,                     {left column of edit window}
  471.       8,                     {top row of edit window}
  472.       72,                    {right column of edit window}
  473.       18,                    {bottom row of edit window}
  474.       BoxTextAttr,           {attribute for normal text}
  475.       BoxTextAttr,           {attribute for control characters}
  476.       True,                  {insert mode on?}
  477.       True,                  {auto-indent on?}
  478.       True,                  {word wrap on?}
  479.       8,                     {distance between tab stops}
  480.       15,                    {help index}
  481.       63,                    {right margin}
  482.       999,                   {maximum number of lines}
  483.       SizeOf(MemoField),     {size of edit buffer}
  484.       Scrap.Notes);          {edit buffer}
  485.  
  486.     {start editing}
  487.     MemoPrompt;
  488.     ExitCommand := EditMemo(EMCB, False, NullCmdList);
  489.     ClearHelpLine;
  490.  
  491.     {$IFDEF UseMouse}
  492.     {hide the mouse cursor}
  493.     HideMouse;
  494.     {$ENDIF}
  495.  
  496.     {erase the window}
  497.     WP2 := EraseTopWindow;
  498.  
  499.     {$IFDEF UseMouse}
  500.     {reveal the mouse cursor}
  501.     ShowMouse;
  502.     {$ENDIF}
  503.   end;
  504.  
  505.   function ConfirmQuitting : Boolean;
  506.     {-Confirm that the user wants to quit}
  507.   var
  508.     ChWord : Word;
  509.     Ch : Char absolute ChWord;
  510.   begin
  511.     while KeyPressed do
  512.       ChWord := ReadKeyWord;
  513.  
  514.     {$IFDEF UseMouse}
  515.     while MousePressed do
  516.       ChWord := MouseKeyWord;
  517.     {$ENDIF}
  518.  
  519.     HiddenCursor;
  520.     DisplayCentered(
  521.       'Are you sure you want to quit? (Press "Y" or <Esc> to confirm.)', HelpLine);
  522.     ChWord := GetKey;
  523.  
  524.     {$IFDEF UseMouse}
  525.       ConfirmQuitting := (Upcase(Ch) = 'Y') or (Ch = #27) or (ChWord = MouseRt);
  526.     {$ELSE}
  527.       ConfirmQuitting := (Upcase(Ch) = 'Y') or (Ch = #27);
  528.     {$ENDIF}
  529.  
  530.     ClearHelpLine;
  531.     NormalCursor;
  532.   end;
  533.  
  534.   procedure PickAState;
  535.     {-Pick a state name from a pick list}
  536.   const
  537.     Choice : Word = 1;
  538.   var
  539.     B : Boolean;
  540.   begin
  541.     {uncomment the following line to home the cursor each time}
  542.     {Choice := 1;}
  543.  
  544.     PickMatrix := 3;
  545.     PickKeyPtr := @GetKey;
  546.     PickSrch := CharPickSrch;
  547.     PickHelpPtr := @DisplayHelp;
  548.  
  549.     {choose a state from the list}
  550.     B := PickWindow(@StateChoice, 51, 8, 7, 73, 19, True, PickColors,
  551.       ' Abbreviated State Names ', Choice);
  552.  
  553.     {do nothing if ESC was pressed}
  554.     if PickCmdNum = PKSSelect then
  555.       {put the name in the actual variable, not Scrap}
  556.       InfoRecs[CurrentRec].State := StateChoice(Choice);
  557.   end;
  558.  
  559.   procedure DrawMainScreen;
  560.     {-Draw the outline of the screen. Fields filled in later}
  561.  
  562.     procedure DrawBox(Row : Byte);
  563.       {-Draw a divided box starting at the specified Row}
  564.     var
  565.       I : Word;
  566.     begin
  567.       {draw the main box}
  568.       for I := Row to Row+4 do
  569.         FastFill(80, ' ', I, 1, BoxAttr);
  570.       FrameWindow(1, Row, 80, Row+4, BoxAttr, BoxAttr, EmptyString);
  571.       FastWrite('├'+CharStr('─', 78)+'┤', Row+2, 1, BoxAttr);
  572.     end;
  573.  
  574.   begin
  575.     ClrScr;
  576.     FrameChars := '╒╘╕╛═│';
  577.  
  578.     {draw the box at the top of the screen}
  579.     DrawBox(TitleLine-1);
  580.     DisplayCentered(Title, TitleLine);
  581.     FastWrite('Date', StatusLine, 32, BoxTextAttr);
  582.     FastWrite('Time', StatusLine, 51, BoxTextAttr);
  583.  
  584.     {draw the box at the bottom of the screen}
  585.     DrawBox(HelpLine-1);
  586.     DisplayCentered(KeyInfoText, KeyInfoLine);
  587.   end;
  588.  
  589.   procedure OpenHelp;
  590.     {-Open ENTRY.HLP}
  591.   var
  592.     Status : Word;
  593.   begin
  594.     {set up our keyboard handler}
  595.     HelpKeyPtr := @GetKey;
  596.  
  597.     {open the help file}
  598.     Status := OpenHelpFile('ENTRY.HLP', 8, 7, 19, 2, HelpColors, HelpP);
  599.     if Status <> 0 then begin
  600.       case Status of
  601.         002 : WriteLn('Help file ENTRY.HLP not found');
  602.         100 : WriteLn('Unexpected end of file reading ENTRY.HLP');
  603.         106 : WriteLn('Help file has invalid format');
  604.         203 : WriteLn('Insufficient heap space available');
  605.         else WriteLn('Help initialization error ', Status);
  606.       end;
  607.       Halt(1);
  608.     end;
  609.   end;
  610.  
  611.   function SecondaryEditScreen : Boolean;
  612.     {-Display secondary edit screen in a popup window. Returns True to advance
  613.       cursor for main edit screen forward, False for backward.}
  614.   var
  615.     ExitCommand : EStype;
  616.     Done : Boolean;
  617.   begin
  618.     {$IFDEF UseMouse}
  619.     {hide the mouse cursor}
  620.     HideMouse;
  621.     {$ENDIF}
  622.  
  623.     {display the window}
  624.     if not DisplayWindow(WP1) then {} ;
  625.  
  626.     {$IFDEF UseMouse}
  627.     {reveal the mouse cursor}
  628.     ShowMouse;
  629.     {$ENDIF}
  630.  
  631.     Done := False;
  632.     repeat
  633.       {start editing}
  634.       ExitCommand := EditScreen(ESR2, ESR2.CurrentID, False);
  635.  
  636.       {copy the edited data back if ESC wasn't pressed}
  637.       if ExitCommand <> ESquit then begin
  638.         InfoRecs[CurrentRec].WPhone := Scrap.WPhone;
  639.         InfoRecs[CurrentRec].HPhone := Scrap.HPhone;
  640.       end;
  641.  
  642.       {see if we need to edit another record}
  643.       case ExitCommand of
  644.         ESuser0 :            {toggle Bell on/off}
  645.           begin
  646.             SetBeepOnError(ESR1, not ESR1.BeepOnError);
  647.             SetBeepOnError(ESR2, not ESR2.BeepOnError);
  648.           end;
  649.         ESnextRec,
  650.         ESprevRec,
  651.         ESquit, ESdone :
  652.           begin
  653.             Done := True;
  654.             SecondaryEditScreen := ExitCommand <> ESprevRec;
  655.           end;
  656.       end;
  657.     until Done;
  658.  
  659.     {$IFDEF UseMouse}
  660.     {hide the mouse cursor}
  661.     HideMouse;
  662.     {$ENDIF}
  663.  
  664.     {erase the window}
  665.     WP1 := EraseTopWindow;
  666.  
  667.     {$IFDEF UseMouse}
  668.     {reveal the mouse cursor}
  669.     ShowMouse;
  670.     {$ENDIF}
  671.   end;
  672.  
  673. begin
  674.   {initialize the database}
  675.   FillChar(Scrap, SizeOf(Scrap), 0);
  676.   FillChar(InfoRecs, SizeOf(InfoRecs), 0);
  677.   for CurrentRec := 1 to MaxRec do begin
  678.     InfoRecs[CurrentRec].Born := BadDate;
  679.     InfoRecs[CurrentRec].Hours := 40;
  680.     InfoRecs[CurrentRec].Notes[1] := ^Z;
  681.   end;
  682.  
  683.   {get international picture mask formats}
  684.   DateMask := InternationalDate(False, False);
  685.   TimeMask := InternationalTime(True, False, True, True);
  686.   WageMask := InternationalCurrency('9', 2, True, False);
  687.   CurrMask := InternationalCurrency('#', 6, True, True);
  688.  
  689.   {handle color mapping manually}
  690.   MapColors := False;
  691.  
  692.   {break checking off}
  693.   CheckBreak := False;
  694.  
  695.   {make sure we're in 80*25 mode}
  696.   case CurrentMode of
  697.     0..1 : TextMode(CurrentMode+2);
  698.     else
  699.      if Hi(LastMode) <> 0 then
  700.        SelectFont8x8(False);
  701.   end;
  702.  
  703.   {set colors based on video mode}
  704.   if WhichHerc = HercInColor then
  705.     CurrentMode := 3;
  706.   case CurrentMode of
  707.     2 : begin
  708.           BoxAttr := $0F;
  709.           BoxTextAttr := $07;
  710.           SetPromptAttr($0F);
  711.           SetFieldAttr($70);
  712.           SetStringAttr($70);
  713.           SetCtrlAttr($70);
  714.           ProtectAttr := $07;
  715.           HelpColors := OurHelpMonocAttr;
  716.         end;
  717.     3 : begin
  718.           BoxAttr := $1D;
  719.           BoxTextAttr := $1B;
  720.           SetPromptAttr($0B);
  721.           SetFieldAttr($1F);
  722.           SetStringAttr($5F);
  723.           SetCtrlAttr($5F);
  724.           ProtectAttr := $0F;
  725.           HelpColors := OurHelpColorAttr;
  726.         end;
  727.     7 : begin
  728.           BoxAttr := $0F;
  729.           BoxTextAttr := $07;
  730.           SetPromptAttr($0F);
  731.           SetFieldAttr($70);
  732.           SetStringAttr($70);
  733.           SetCtrlAttr($70);
  734.           ProtectAttr := $07;
  735.           HelpColors := OurHelpMonocAttr;
  736.         end;
  737.   end;
  738.   if WhichHerc = HercInColor then
  739.     CurrentMode := GetCrtMode;
  740.   TextAttr := ESpromptAttr;
  741.   SaveFieldAttr := ESfieldAttr;
  742.   PickColors[WindowAttr] := BoxTextAttr;
  743.   PickColors[FrameAttr] := BoxAttr;
  744.   PickColors[HeaderAttr] := ESstringAttr;
  745.   PickColors[SelectAttr] := ESstringAttr;
  746.   PickColors[AltNormal] := BoxTextAttr;
  747.   PickColors[AltHigh] := ESstringAttr;
  748.  
  749.   {make a window for the secondary edit screen}
  750.   if not MakeWindow(WP1, 17, 12, 63, 15, True, True, True, BoxTextAttr,
  751.     BoxAttr, ESstringAttr, ' Phone Numbers ') then
  752.     Halt(1);
  753.  
  754.   {make a window for the memo editor}
  755.   if not MakeWindow(WP2, 8, 7, 73, 19, True, True, True, BoxTextAttr,
  756.     BoxAttr, ESstringAttr, ' Notes ') then
  757.     Halt(1);
  758.  
  759.   {open the help file}
  760.   OpenHelp;
  761.  
  762.   {draw basic outline of the screen}
  763.   DrawMainScreen;
  764.  
  765.   {$IFDEF UseMouse}
  766.   if MouseInstalled then begin
  767.     {use a diamond of the same color as field prompts for our mouse cursor}
  768.     SoftMouseCursor($0000, (ESpromptAttr shl 8)+$04);
  769.     ShowMouse;
  770.  
  771.     {enable mouse support}
  772.     EnableEntryMouse;
  773.     EnablePickMouse;
  774.     EnableHelpMouse;
  775.     EnableMemoMouse
  776.   end;
  777.   {$ENDIF}
  778.  
  779.   {initialize the edit screen record}
  780.   InitESrecord(ESR1);
  781.  
  782.   {install user-written event handlers}
  783.   SetPreEditPtr(ESR1, @DisplayHelpPrompt);
  784.   SetPostEditPtr(ESR1, @UpdateHandler);
  785.   SetErrorPtr(ESR1, @ErrorHandler);
  786.   EntryKeyPtr := @GetKey;
  787.   MemoKeyPtr := @GetKey;
  788.   EntryHelpPtr := @DisplayHelp;
  789.   MemoHelpPtr := @DisplayHelp;
  790.   MemoStatusPtr := @MemoFieldStatus;
  791.   MemoErrorPtr := @MemoErrorHandler;
  792.  
  793.   {set up user exit keys}
  794.   {<AltB> turns bell on/off}
  795.   if not AddEntryCommand(ESuser0, 1, $3000, 0) then ;
  796.   {<F2> pops up pick list for State field}
  797.   if not AddEntryCommand(ESuser1, 1, $3C00, 0) then ;
  798.  
  799.   {set edit screen options}
  800.   SetWrapMode(ESR1, WrapAtEdges);
  801.   SetBeepOnError(ESR1, On);
  802.  
  803.   {set field editing options}
  804.   SetClearFirstChar(On);
  805.  
  806.   {add each of the edit fields in order: left to right, top to bottom}
  807.   {                              Prompt                     Field   Fld Hlp Val}
  808.   {Range     Range     Prompt    Row Col Picture            Row Col Len Ndx Ptr}
  809.   {Low       High      Decimals  Field                                         }
  810.  
  811.   SavePromptAttr := ESpromptAttr;
  812.   SetPromptAttr(BoxTextAttr);
  813.   SetProtection(On);
  814.   AddByteField(ESR1,   'Record', 04, 17, '99',              04, 25,     0,
  815.    0,        0,                  CurrentRec);  {** <-- not part of Scrap! **}
  816.   SetProtection(Off);
  817.   SetPromptAttr(SavePromptAttr);
  818.  
  819.   AddStringField(ESR1, 'Name',   07, 19, '',                07, 25, 30, 1,  nil,
  820.                                  Scrap.Name);
  821.  
  822.   SetRequired(On);
  823.   AddStringField(ESR1, 'Address',08, 16, '',                08, 25, 30, 2,  nil,
  824.                                  Scrap.Address);
  825.   SetRequired(Off);
  826.  
  827.   SetInsertPushes(Off);
  828.   AddStringField(ESR1, 'City',   09, 19, '',                09, 25, 25, 3,  nil,
  829.                                  Scrap.City);
  830.   SetInsertPushes(On);
  831.  
  832.   {$IFDEF UseMouse}
  833.   SetExitOnSecondClick(On);
  834.   {$ENDIF}
  835.   AddStringField(ESR1, 'State',  10, 18, 'AA',              10, 25, 02, 4, @ValidateNotPartial,
  836.                                  Scrap.State);
  837.   {$IFDEF UseMouse}
  838.   SetExitOnSecondClick(Off);
  839.   {$ENDIF}
  840.  
  841.   AddStringField(ESR1, 'Zip',    10, 52, ZipMask,           10, 57, 10, 5, @ValidateZip,
  842.                                  Scrap.Zip);
  843.  
  844.   AddNestedField(ESR1, 'Phones', 11, 17, '',                11, 25,  2, 6);
  845.  
  846.   {multiple-choice field}
  847.   AddChoiceField(ESR1, 'Gender', 13, 17, 'XXXXXXX',         13, 25,     7,
  848.    1,        @IncChoice,         Scrap.Gender);
  849.  
  850.   AddYesNoField(ESR1, 'Married', 13, 48, '',                13, 57,     8,
  851.                                  Scrap.Married);
  852.   AddDateField(ESR1, 'Born',     14, 19, DateMask,          14, 25,     9,
  853.    0,        0,                  Scrap.Born);
  854.  
  855.   {a calculated field}
  856.   SetProtection(On);
  857.   SetFieldAttr(ProtectAttr);
  858.   AddByteField(ESR1, 'Age',      14, 52, '999',             14, 57,     10,
  859.    0,        0,                  Scrap.Age);
  860.   SetFieldAttr(SaveFieldAttr);
  861.   SetProtection(Off);
  862.  
  863.   {a numeric field}
  864.   SetNumeric(On);
  865.   AddRealField(ESR1, 'Hourly wage',16,12,WageMask,          16, 25,     11,
  866.    0,        999.99,   0,        Scrap.Wage);
  867.   SetNumeric(Off);
  868.  
  869.   {a calculated field}
  870.   SetProtection(On);
  871.   SetFieldAttr(ProtectAttr);
  872.   SetPadChar('*');
  873.   AddRealField(ESR1, 'Weekly',   16, 49, CurrMask,          16, 57,     12,
  874.    0,        0,        0,        Scrap.Weekly);
  875.   SetPadChar(' ');
  876.   SetFieldAttr(SaveFieldAttr);
  877.   SetProtection(Off);
  878.  
  879.   {multiple-choice field}
  880.   AddChoiceField(ESR1, 'Hours/week',17,13,'99',             17, 25,     13,
  881.    1,        @IncChoice,         Scrap.Hours);
  882.  
  883.   {a calculated field}
  884.   SetProtection(On);
  885.   SetFieldAttr(ProtectAttr);
  886.   SetPadChar('*');
  887.   AddRealField(ESR1, 'Yearly',   17, 49, CurrMask,          17, 57,     14,
  888.    0,        0,        0,        Scrap.Yearly);
  889.   SetPadChar(' ');
  890.   SetFieldAttr(SaveFieldAttr);
  891.   SetProtection(Off);
  892.  
  893.   AddNestedField(ESR1, 'Notes',  19, 18, '',                19, 25, 2,  15);
  894.  
  895.   {now set up the secondary edit screen}
  896.   InitESrecord(ESR2);
  897.   SetPreEditPtr(ESR2, @DisplayHelpPrompt2);
  898.   SetErrorPtr(ESR2, @ErrorHandler);
  899.   SetWrapMode(ESR2, ExitAtEdges);
  900.   SetAutoAdvance(On);
  901.   SetBeepOnError(ESR2, On);
  902.   SetPadChar('_');
  903.   ESpromptAttr := BoxTextAttr;
  904.   AddStringField(ESR2, 'Work phone number', 13, 25, PhoneMask, 13, 43, 14, 16,
  905.     @ValidatePhone, Scrap.WPhone);
  906.   AddStringField(ESR2, 'Home phone number', 14, 25, PhoneMask, 14, 43, 14, 17,
  907.     @ValidatePhone, Scrap.HPhone);
  908.   ESpromptAttr := TextAttr;
  909.   SetPadChar(' ');
  910.  
  911.   CurrentRec := 1;
  912.   AllDone := False;
  913.   repeat
  914.     {copy the current record into the scrap record used for editing}
  915.     Scrap := InfoRecs[CurrentRec];
  916.  
  917.     {start editing}
  918.     ExitCommand := EditScreen(ESR1, ESR1.CurrentID, False);
  919.  
  920.     if ExitCommand = ESquit then
  921.       {confirm that the user wants to quit}
  922.       if not ConfirmQuitting then
  923.         ExitCommand := ESnone;
  924.  
  925.     {copy the edited record back if ESC wasn't pressed}
  926.     if ExitCommand <> ESquit then
  927.       InfoRecs[CurrentRec] := Scrap;
  928.  
  929.     {see if we need to edit another record}
  930.     case ExitCommand of
  931.       ESdone,                {^Enter, ^KD, or ^KQ}
  932.       ESquit :               {ESC}
  933.         AllDone := True;
  934.       ESnextRec :            {next record}
  935.         if CurrentRec < MaxRec then
  936.           Inc(CurrentRec);
  937.       ESprevRec :            {previous record}
  938.         if CurrentRec > 1 then
  939.           Dec(CurrentRec);
  940.       ESuser0 :              {toggle Bell on/off}
  941.         begin
  942.           SetBeepOnError(ESR1, not ESR1.BeepOnError);
  943.           SetBeepOnError(ESR2, not ESR2.BeepOnError);
  944.         end;
  945.       {$IFDEF UseMouse}
  946.       ESclickExit,
  947.       {$ENDIF}
  948.       ESuser1 :              {pick a state}
  949.         if ESR1.CurrentID = 4 then
  950.           PickAState;
  951.       ESnested :             {handle nested form}
  952.         if ESR1.CurrentID = 15 then begin
  953.           {edit the notes field}
  954.           EditMemoField;
  955.  
  956.           {copy the notes field}
  957.           InfoRecs[CurrentRec].Notes := Scrap.Notes;
  958.         end
  959.         {switch to secondary edit screen}
  960.         else if SecondaryEditScreen then
  961.           {advance to next field in main screen (Gender)}
  962.           Inc(ESR1.CurrentID)
  963.         else
  964.           {back up to State field}
  965.           Dec(ESR1.CurrentID, 2);
  966.     end;
  967.   until AllDone;
  968.  
  969.   {$IFDEF UseMouse}
  970.   {hide the mouse cursor}
  971.   HideMouse;
  972.   {$ENDIF}
  973.  
  974.   {these calls are unnecessary in this case}
  975.   DisposeEditScreen(ESR1);
  976.   DisposeEditScreen(ESR2);
  977.   DisposeWindow(WP1);
  978.   DisposeWindow(WP2);
  979.  
  980.   {clean up display}
  981.   NormVideo;
  982.   ClrScr;
  983. end.
  984.